home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / gets52.zip / NOMODS.PRG < prev   
Text File  |  1993-03-27  |  2KB  |  63 lines

  1. /*
  2.  
  3.    'getlist' jumping in Clipper 5.2 without modifying GETSYS.PRG.
  4.    in the example below, GET 1 jumps to GET 3 ; GET 5 to GET 2.
  5.  
  6.    also included is READ AT POSITION.  you'll note that the READ begins
  7.    at GET 4.
  8.  
  9.    remember, this is to be used with Clipper's GETSYS.PRG, and not with
  10.    GETSYSSK.PRG included in the .ZIP.
  11.  
  12.    Contact:
  13.    Steve Kolterman  [76320,37]
  14.  
  15. */
  16.  
  17. // in your source code:
  18. #include "inkey.ch"
  19. #include "getexit.ch"
  20.  
  21. #xcomm READ [<sv: SAVE>] [AT POSITION <pos>]  =>  ;
  22.        ReadNJump( getlist,[<pos>] )  ;
  23.        [; IIF( !<.sv.>, getlist:= {}, ) ]
  24.  
  25. #define ORDPOS     cargo[1]
  26. #define JUMP2POS   cargo[2]
  27.  
  28. FUNCTION Test
  29. LOCAL getlist:= {},nX,aGets[5],nRow:= 5
  30.  
  31. FOR nX:= 1 TO Len(aGets)
  32.    aGets[nX]:= nX
  33.    @ ++nRow,5 GET aGets[nX]
  34.    getlist[nX]:cargo:= {nX,0}
  35.    IIF( nX==1 .or. nX==5,getlist[nX]:postblock:= {|g| GetJump(g)}, )
  36. NEXT
  37.  
  38. READ AT POSITION 4
  39.  
  40. RETURN NIL
  41.  
  42. FUNCTION GetJump(oGet)
  43. LOCAL nPos:= IIF( oGet:ORDPOS==1,3,2 )
  44. oGet:JUMP2POS:= nPos
  45. oGet:exitstate:= GE_WRITE
  46. RETURN .T.
  47.  
  48. FUNCTION ReadNJump( getlist,nReadPos )
  49. LOCAL nKey:= 0,lUpdated:= .F.,nGetPos
  50. IIF( nReadPos==NIL,nReadPos:= 1, )
  51.  
  52. WHILE nReadPos > 0 .and. nKey <> K_ESC
  53.     lUpdated:= ReadModal( getlist,nReadPos )
  54.     nKey:= Lastkey()
  55.     // if we had a jump, do it.
  56.     IF (nGetPos:= Ascan( getlist,{|e| e:JUMP2POS > 0} )) > 0
  57.        // reset for another entry.
  58.        nReadPos:= getlist[nGetPos]:JUMP2POS
  59.        getlist[nGetPos]:JUMP2POS:= 0
  60.     ENDIF
  61. ENDDO
  62. RETURN lUpdated
  63.